home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / amiga / plotting / gnuplot3.lzh / gnuplot / misc.c < prev    next >
C/C++ Source or Header  |  1991-08-22  |  22KB  |  874 lines

  1. /* GNUPLOT - misc.c */
  2. /*
  3.  * Copyright (C) 1986, 1987, 1990, 1991   Thomas Williams, Colin Kelley
  4.  *
  5.  * Permission to use, copy, and distribute this software and its
  6.  * documentation for any purpose with or without fee is hereby granted, 
  7.  * provided that the above copyright notice appear in all copies and 
  8.  * that both that copyright notice and this permission notice appear 
  9.  * in supporting documentation.
  10.  *
  11.  * Permission to modify the software is granted, but not the right to
  12.  * distribute the modified code.  Modifications are to be distributed 
  13.  * as patches to released version.
  14.  *  
  15.  * This software is provided "as is" without express or implied warranty.
  16.  * 
  17.  *
  18.  * AUTHORS
  19.  * 
  20.  *   Original Software:
  21.  *     Thomas Williams,  Colin Kelley.
  22.  * 
  23.  *   Gnuplot 2.0 additions:
  24.  *       Russell Lang, Dave Kotz, John Campbell.
  25.  *
  26.  *   Gnuplot 3.0 additions:
  27.  *       Gershon Elber and many others.
  28.  * 
  29.  * Send your comments or suggestions to 
  30.  *  pixar!info-gnuplot@sun.com.
  31.  * This is a mailing list; to join it send a note to 
  32.  *  pixar!info-gnuplot-request@sun.com.  
  33.  * Send bug reports to
  34.  *  pixar!bug-gnuplot@sun.com.
  35.  */
  36.  
  37. #include <stdio.h>
  38. #include <math.h>
  39. #include "plot.h"
  40. #include "setshow.h"
  41. #include "help.h"
  42. #ifdef __TURBOC__
  43. #include <graphics.h>
  44. #endif
  45.  
  46. #ifndef _IBMR2
  47. extern char *malloc();
  48. extern char *realloc();
  49. #endif
  50.  
  51. extern int c_token;
  52. extern char replot_line[];
  53. extern struct at_type at;
  54. extern struct ft_entry ft[];
  55. extern struct udft_entry *first_udf;
  56. extern struct udvt_entry *first_udv;
  57.  
  58. extern struct at_type *temp_at();
  59.  
  60. extern BOOLEAN interactive;
  61. extern char *infile_name;
  62. extern int inline_num;
  63.  
  64. /* State information for load_file(), to recover from errors
  65.  * and properly handle recursive load_file calls
  66.  */
  67. typedef struct lf_state_struct LFS;
  68. struct lf_state_struct {
  69.     FILE *fp;                /* file pointer for load file */
  70.     char *name;            /* name of file */
  71.     BOOLEAN interactive;        /* value of interactive flag on entry */
  72.     int inline_num;            /* inline_num on entry */
  73.     LFS *prev;                /* defines a stack */
  74. } *lf_head = NULL;            /* NULL if not in load_file */
  75.  
  76. static BOOLEAN lf_pop();
  77. static void lf_push();
  78.  
  79. /*
  80.  * instead of <strings.h>
  81.  */
  82. extern int strcmp();
  83.  
  84. /*
  85.  * Turbo C realloc does not do the right thing. Here is what it should do.
  86.  */
  87. #ifdef __TURBOC__
  88. char *realloc(p, new_size)
  89.           void *p;
  90.           size_t new_size;
  91. {
  92.     void *new_p = alloc(new_size, "TC realloc");
  93.  
  94.     /* Note p may have less than new_size bytes but in this unprotected
  95.      * environment this will work.
  96.      */
  97.     memcpy(new_p, p, new_size);
  98.     free(p);
  99.     return new_p;
  100. }
  101. #endif /* __TURBOC__ */
  102.  
  103. /*
  104.  * cp_alloc() allocates a curve_points structure that can hold 'num'
  105.  * points.
  106.  */
  107. struct curve_points *
  108. cp_alloc(num)
  109.     int num;
  110. {
  111.     struct curve_points *cp;
  112.     cp = (struct curve_points *) alloc(sizeof(struct curve_points), "curve");
  113.     cp->p_max = (num >= 0 ? num : 0);
  114.     if (num > 0) {
  115.        cp->points = (struct coordinate *)
  116.         alloc(num * sizeof(struct coordinate), "curve points");
  117.     } else
  118.        cp->points = (struct coordinate *) NULL;
  119.     cp->next_cp = NULL;
  120.     cp->title = NULL;
  121.     return(cp);
  122. }
  123.  
  124.  
  125. /*
  126.  * cp_extend() reallocates a curve_points structure to hold "num"
  127.  * points. This will either expand or shrink the storage.
  128.  */
  129. cp_extend(cp, num)
  130.     struct curve_points *cp;
  131.     int num;
  132. {
  133.     struct coordinate *new;
  134.  
  135. #ifdef PC
  136.     /* Make sure we do not allocate more than 64k (8088 architecture...)
  137.      * in msdos since we can not address more. Leave some bytes for malloc
  138.      * maintainance.
  139.      */
  140.     if (num > 65500L / sizeof(struct coordinate))
  141.     int_error("Can not allocate more than 64k in msdos", NO_CARET);
  142. #endif /* PC */
  143.  
  144.     if (num == cp->p_max) return;
  145.  
  146.     if (num > 0) {
  147.        if (cp->points == NULL) {
  148.           cp->points = (struct coordinate *)
  149.             alloc(num * sizeof(struct coordinate), "curve points");
  150.        } else {
  151.           new = (struct coordinate *)
  152.             realloc(cp->points, num * sizeof(struct coordinate));
  153.           if (new == (struct coordinate *) NULL) {
  154.              int_error("No memory available for expanding curve points",
  155.                      NO_CARET);
  156.              /* NOTREACHED */
  157.           }
  158.           cp->points = new;
  159.        }
  160.        cp->p_max = num;
  161.     } else {
  162.        if (cp->points != (struct coordinate *) NULL)
  163.         free(cp->points);
  164.        cp->points = (struct coordinate *) NULL;
  165.        cp->p_max = 0;
  166.     }
  167. }
  168.  
  169. /*
  170.  * cp_free() releases any memory which was previously malloc()'d to hold
  171.  *   curve points (and recursively down the linked list).
  172.  */
  173. cp_free(cp)
  174. struct curve_points *cp;
  175. {
  176.     if (cp) {
  177.         cp_free(cp->next_cp);
  178.         if (cp->title)
  179.             free((char *)cp->title);
  180.         if (cp->points)
  181.             free((char *)cp->points);
  182.         free((char *)cp);
  183.     }
  184. }
  185.  
  186. /*
  187.  * iso_alloc() allocates a iso_curve structure that can hold 'num'
  188.  * points.
  189.  */
  190. struct iso_curve *
  191. iso_alloc(num)
  192.     int num;
  193. {
  194.     struct iso_curve *ip;
  195.     ip = (struct iso_curve *) alloc(sizeof(struct iso_curve), "iso curve");
  196.     ip->p_max = (num >= 0 ? num : 0);
  197.     if (num > 0) {
  198.        ip->points = (struct coordinate *)
  199.         alloc(num * sizeof(struct coordinate), "iso curve points");
  200.     } else
  201.        ip->points = (struct coordinate *) NULL;
  202.     ip->next = NULL;
  203.     return(ip);
  204. }
  205.  
  206. /*
  207.  * iso_extend() reallocates a iso_curve structure to hold "num"
  208.  * points. This will either expand or shrink the storage.
  209.  */
  210. iso_extend(ip, num)
  211.     struct iso_curve *ip;
  212.     int num;
  213. {
  214.     struct coordinate *new;
  215.  
  216.     if (num == ip->p_max) return;
  217.  
  218. #ifdef PC
  219.     /* Make sure we do not allocate more than 64k (8088 architecture...)
  220.      * in msdos since we can not address more. Leave some bytes for malloc
  221.      * maintainance.
  222.      */
  223.     if (num > 65500L / sizeof(struct coordinate))
  224.     int_error("Can not allocate more than 64k in msdos", NO_CARET);
  225. #endif /* PC */
  226.  
  227.     if (num > 0) {
  228.        if (ip->points == NULL) {
  229.           ip->points = (struct coordinate *)
  230.             alloc(num * sizeof(struct coordinate), "iso curve points");
  231.        } else {
  232.           new = (struct coordinate *)
  233.             realloc(ip->points, num * sizeof(struct coordinate));
  234.           if (new == (struct coordinate *) NULL) {
  235.              int_error("No memory available for expanding curve points",
  236.                      NO_CARET);
  237.              /* NOTREACHED */
  238.           }
  239.           ip->points = new;
  240.        }
  241.        ip->p_max = num;
  242.     } else {
  243.        if (ip->points != (struct coordinate *) NULL)
  244.         free(ip->points);
  245.        ip->points = (struct coordinate *) NULL;
  246.        ip->p_max = 0;
  247.     }
  248. }
  249.  
  250. /*
  251.  * iso_free() releases any memory which was previously malloc()'d to hold
  252.  *   iso curve points.
  253.  */
  254. iso_free(ip)
  255. struct iso_curve *ip;
  256. {
  257.     if (ip) {
  258.         if (ip->points)
  259.             free((char *)ip->points);
  260.         free((char *)ip);
  261.     }
  262. }
  263.  
  264. /*
  265.  * sp_alloc() allocates a surface_points structure that can hold 'num_iso'
  266.  * iso-curves, each of which 'num_samp' samples.
  267.  * if, however num_iso or num_samp is zero no iso curves are allocated.
  268.  */
  269. struct surface_points *
  270. sp_alloc(num_samp,num_iso)
  271.     int num_samp,num_iso;
  272. {
  273.     struct surface_points *sp;
  274.  
  275.     sp = (struct surface_points *) alloc(sizeof(struct surface_points), "surface");
  276.     sp->next_sp = NULL;
  277.     sp->title = NULL;
  278.     sp->contours = NULL;
  279.     sp->iso_crvs = NULL;
  280.     sp->num_iso_read = 0;
  281.  
  282.     if (num_iso > 0 && num_samp > 0) {
  283.     int i;
  284.     struct iso_curve *icrv;
  285.  
  286.     for (i = 0; i < num_iso; i++) {
  287.         icrv = iso_alloc(num_samp);
  288.         icrv->next = sp->iso_crvs;
  289.         sp->iso_crvs = icrv;
  290.     }
  291.     } else
  292.     sp->iso_crvs = (struct iso_curve *) NULL;
  293.  
  294.     return(sp);
  295. }
  296.  
  297. /*
  298.  * sp_replace() updates a surface_points structure so it can hold 'num_iso'
  299.  * iso-curves, each of which 'num_samp' samples.
  300.  * if, however num_iso or num_samp is zero no iso curves are allocated.
  301.  */
  302. sp_replace(sp,num_samp,num_iso)
  303.        struct surface_points *sp;
  304.        int num_samp,num_iso;
  305. {
  306.     int i;
  307.     struct iso_curve *icrv, *icrvs = sp->iso_crvs;
  308.  
  309.     while ( icrvs ) {
  310.     icrv = icrvs;
  311.     icrvs = icrvs->next;
  312.     iso_free( icrv );
  313.     }
  314.     sp->iso_crvs = NULL;
  315.     
  316.     if (num_iso > 0 && num_samp > 0) {
  317.     for (i = 0; i < num_iso; i++) {
  318.         icrv = iso_alloc(num_samp);
  319.         icrv->next = sp->iso_crvs;
  320.         sp->iso_crvs = icrv;
  321.     }
  322.     } else
  323.     sp->iso_crvs = (struct iso_curve *) NULL;
  324. }
  325.  
  326. /*
  327.  * sp_free() releases any memory which was previously malloc()'d to hold
  328.  *   surface points.
  329.  */
  330. sp_free(sp)
  331. struct surface_points *sp;
  332. {
  333.     if (sp) {
  334.         sp_free(sp->next_sp);
  335.         if (sp->title)
  336.             free((char *)sp->title);
  337.         if (sp->contours) {
  338.             struct gnuplot_contours *cntr, *cntrs = sp->contours;
  339.  
  340.             while (cntrs) {
  341.                 cntr = cntrs;
  342.                 cntrs = cntrs->next;
  343.                 free(cntr->coords);
  344.                 free(cntr);
  345.             }
  346.         }
  347.         if (sp->iso_crvs) {
  348.             struct iso_curve *icrv, *icrvs = sp->iso_crvs;
  349.  
  350.             while (icrvs) {
  351.                 icrv = icrvs;
  352.                 icrvs = icrvs->next;
  353.                 iso_free(icrv);
  354.             }
  355.         }
  356.         free((char *)sp);
  357.     }
  358. }
  359.  
  360.  
  361.  
  362. save_functions(fp)
  363. FILE *fp;
  364. {
  365. register struct udft_entry *udf = first_udf;
  366.  
  367.     if (fp) {
  368.         while (udf) {
  369.             if (udf->definition)
  370.                 fprintf(fp,"%s\n",udf->definition);
  371.             udf = udf->next_udf;
  372.         }
  373.         (void) fclose(fp);
  374.     } else
  375.         os_error("Cannot open save file",c_token);            
  376. }
  377.  
  378.  
  379. save_variables(fp)
  380. FILE *fp;
  381. {
  382. register struct udvt_entry *udv = first_udv->next_udv;    /* skip pi */
  383.  
  384.     if (fp) {
  385.         while (udv) {
  386.             if (!udv->udv_undef) {
  387.                 fprintf(fp,"%s = ",udv->udv_name);
  388.                 disp_value(fp,&(udv->udv_value));
  389.                 (void) putc('\n',fp);
  390.             }
  391.             udv = udv->next_udv;
  392.         }
  393.         (void) fclose(fp);
  394.     } else
  395.         os_error("Cannot open save file",c_token);            
  396. }
  397.  
  398.  
  399. save_all(fp)
  400. FILE *fp;
  401. {
  402. register struct udft_entry *udf = first_udf;
  403. register struct udvt_entry *udv = first_udv->next_udv;    /* skip pi */
  404.  
  405.     if (fp) {
  406.         save_set_all(fp);
  407.         while (udf) {
  408.             if (udf->definition)
  409.                 fprintf(fp,"%s\n",udf->definition);
  410.             udf = udf->next_udf;
  411.         }
  412.         while (udv) {
  413.             if (!udv->udv_undef) {
  414.                 fprintf(fp,"%s = ",udv->udv_name);
  415.                 disp_value(fp,&(udv->udv_value));
  416.                 (void) putc('\n',fp);
  417.             }
  418.             udv = udv->next_udv;
  419.         }
  420.         fprintf(fp,"%s\n",replot_line);
  421.         (void) fclose(fp);
  422.     } else
  423.         os_error("Cannot open save file",c_token);            
  424. }
  425.  
  426.  
  427. save_set(fp)
  428. FILE *fp;
  429. {
  430.     if (fp) {
  431.         save_set_all(fp);
  432.         (void) fclose(fp);
  433.     } else
  434.         os_error("Cannot open save file",c_token);            
  435. }
  436.  
  437.  
  438. save_set_all(fp)
  439. FILE *fp;
  440. {
  441. struct text_label *this_label;
  442. struct arrow_def *this_arrow;
  443.     fprintf(fp,"set terminal %s %s\n", term_tbl[term].name, term_options);
  444.     fprintf(fp,"set output %s\n",strcmp(outstr,"STDOUT")? outstr : "" );
  445.     fprintf(fp,"set %sclip points\n", (clip_points)? "" : "no");
  446.     fprintf(fp,"set %sclip one\n", (clip_lines1)? "" : "no");
  447.     fprintf(fp,"set %sclip two\n", (clip_lines2)? "" : "no");
  448.     fprintf(fp,"set %sborder\n",draw_border ? "" : "no");
  449.     fprintf(fp,"set dummy %s,%s\n",dummy_var[0], dummy_var[1]);
  450.     fprintf(fp,"set format x \"%s\"\n", xformat);
  451.     fprintf(fp,"set format y \"%s\"\n", yformat);
  452.     fprintf(fp,"set format z \"%s\"\n", zformat);
  453.     fprintf(fp,"set %sgrid\n", (grid)? "" : "no");
  454.     switch (key) {
  455.         case -1 : 
  456.             fprintf(fp,"set key\n");
  457.             break;
  458.         case 0 :
  459.             fprintf(fp,"set nokey\n");
  460.             break;
  461.         case 1 :
  462.             fprintf(fp,"set key %g,%g,%g\n",key_x,key_y,key_z);
  463.             break;
  464.     }
  465.     fprintf(fp,"set nolabel\n");
  466.     for (this_label = first_label; this_label != NULL;
  467.             this_label = this_label->next) {
  468.         fprintf(fp,"set label %d \"%s\" at %g,%g,%g ",
  469.                this_label->tag,
  470.                this_label->text, this_label->x,
  471.                          this_label->y,
  472.                          this_label->z);
  473.         switch(this_label->pos) {
  474.             case LEFT : 
  475.                 fprintf(fp,"left");
  476.                 break;
  477.             case CENTRE :
  478.                 fprintf(fp,"centre");
  479.                 break;
  480.             case RIGHT :
  481.                 fprintf(fp,"right");
  482.                 break;
  483.         }
  484.         fputc('\n',fp);
  485.     }
  486.     fprintf(fp,"set noarrow\n");
  487.     for (this_arrow = first_arrow; this_arrow != NULL;
  488.             this_arrow = this_arrow->next) {
  489.         fprintf(fp,"set arrow %d from %g,%g,%g to %g,%g,%g%s\n",
  490.                this_arrow->tag,
  491.                this_arrow->sx, this_arrow->sy, this_arrow->sz,
  492.                this_arrow->ex, this_arrow->ey, this_arrow->ez,
  493.                this_arrow->head ? "" : " nohead");
  494.     }
  495.     fprintf(fp,"set nologscale\n");
  496.     if (log_x||log_y)
  497.         fprintf(fp,"set logscale %c%c\n", 
  498.         log_x ? 'x' : ' ', log_y ? 'y' : ' ');
  499.     if (log_z) fprintf(fp,"set logscale z\n");
  500.     fprintf(fp,"set offsets %g, %g, %g, %g\n",loff,roff,toff,boff);
  501.     fprintf(fp,"set %spolar\n", (polar)? "" : "no");
  502.     fprintf(fp,"set angles %s\n", (angles_format == ANGLES_RADIANS)?
  503.                         "radians" : "degrees");
  504.     fprintf(fp,"set %sparametric\n", (parametric)? "" : "no");
  505.     fprintf(fp,"set view %g, %g, %g, %g\n",
  506.         surface_rot_x, surface_rot_z, surface_scale, surface_zscale);
  507.     fprintf(fp,"set samples %d\n",samples);
  508.     fprintf(fp,"set isosamples %d\n",iso_samples);
  509.     fprintf(fp,"set %ssurface\n",(draw_surface) ? "" : "no");
  510.     fprintf(fp,"set %scontour",(draw_contour) ? "" : "no");
  511.     switch (draw_contour) {
  512.         case CONTOUR_NONE: fprintf(fp, "\n"); break;
  513.         case CONTOUR_BASE: fprintf(fp, " base\n"); break;
  514.         case CONTOUR_SRF:  fprintf(fp, " surface\n"); break;
  515.         case CONTOUR_BOTH: fprintf(fp, " both\n"); break;
  516.     }
  517.     fprintf(fp,"set cntrparam order %d\n", contour_order);
  518.     fprintf(fp,"set cntrparam ");
  519.     switch (contour_kind) {
  520.         case CONTOUR_KIND_LINEAR:    fprintf(fp, "linear\n"); break;
  521.         case CONTOUR_KIND_CUBIC_SPL: fprintf(fp, "cubicspline\n"); break;
  522.         case CONTOUR_KIND_BSPLINE:   fprintf(fp, "bspline\n"); break;
  523.     }
  524.     fprintf(fp,"set cntrparam points %d\n", contour_pts);
  525.     fprintf(fp,"set size %g,%g\n",xsize,ysize);
  526.     fprintf(fp,"set data style ");
  527.     switch (data_style) {
  528.         case LINES: fprintf(fp,"lines\n"); break;
  529.         case POINTS: fprintf(fp,"points\n"); break;
  530.         case IMPULSES: fprintf(fp,"impulses\n"); break;
  531.         case LINESPOINTS: fprintf(fp,"linespoints\n"); break;
  532.         case DOTS: fprintf(fp,"dots\n"); break;
  533.         case ERRORBARS: fprintf(fp,"errorbars\n"); break;
  534.     }
  535.     fprintf(fp,"set function style ");
  536.     switch (func_style) {
  537.         case LINES: fprintf(fp,"lines\n"); break;
  538.         case POINTS: fprintf(fp,"points\n"); break;
  539.         case IMPULSES: fprintf(fp,"impulses\n"); break;
  540.         case LINESPOINTS: fprintf(fp,"linespoints\n"); break;
  541.         case DOTS: fprintf(fp,"dots\n"); break;
  542.         case ERRORBARS: fprintf(fp,"errorbars\n"); break;
  543.     }
  544.     fprintf(fp,"set tics %s\n", (tic_in)? "in" : "out");
  545.     fprintf(fp,"set ticslevel %g\n", ticslevel);
  546.     save_tics(fp, xtics, 'x', &xticdef);
  547.     save_tics(fp, ytics, 'y', &yticdef);
  548.     save_tics(fp, ztics, 'z', &zticdef);
  549.     fprintf(fp,"set title \"%s\" %d,%d\n",title,title_xoffset,title_yoffset);
  550.         if (timedate)
  551.         fprintf(fp,"set time %d,%d\n",time_xoffset,time_yoffset);
  552.     else
  553.         fprintf(fp,"set notime\n");
  554.      fprintf(fp,"set rrange [%g : %g]\n",rmin,rmax);
  555.     fprintf(fp,"set trange [%g : %g]\n",tmin,tmax);
  556.     fprintf(fp,"set xlabel \"%s\" %d,%d\n",xlabel,xlabel_xoffset,xlabel_yoffset);
  557.     fprintf(fp,"set xrange [%g : %g]\n",xmin,xmax);
  558.     fprintf(fp,"set ylabel \"%s\" %d,%d\n",ylabel,ylabel_xoffset,ylabel_yoffset);
  559.     fprintf(fp,"set yrange [%g : %g]\n",ymin,ymax);
  560.     fprintf(fp,"set zlabel \"%s\" %d,%d\n",zlabel,zlabel_xoffset,zlabel_yoffset);
  561.     fprintf(fp,"set zrange [%g : %g]\n",zmin,zmax);
  562.     fprintf(fp,"set %s %c\n", 
  563.         autoscale_r ? "autoscale" : "noautoscale", 'r');
  564.     fprintf(fp,"set %s %c\n", 
  565.         autoscale_t ? "autoscale" : "noautoscale", 't');
  566.     fprintf(fp,"set %s %c%c\n", 
  567.         (autoscale_y||autoscale_x) ? "autoscale" : "noautoscale", 
  568.         autoscale_x ? 'x' : ' ', autoscale_y ? 'y' : ' ');
  569.     fprintf(fp,"set %s %c\n", 
  570.         autoscale_z ? "autoscale" : "noautoscale", 'z');
  571.     fprintf(fp,"set zero %g\n",zero);
  572. }
  573.  
  574. save_tics(fp, onoff, axis, tdef)
  575.     FILE *fp;
  576.     BOOLEAN onoff;
  577.     char axis;
  578.     struct ticdef *tdef;
  579. {
  580.     if (onoff) {
  581.        fprintf(fp,"set %ctics", axis);
  582.        switch(tdef->type) {
  583.           case TIC_COMPUTED: {
  584.              break;
  585.           }
  586.           case TIC_SERIES: {
  587.                  if (tdef->def.series.end >= VERYLARGE)
  588.                  fprintf(fp, " %g,%g", tdef->def.series.start,
  589.                                         tdef->def.series.incr);
  590.                          else
  591.                  fprintf(fp, " %g,%g,%g", tdef->def.series.start,
  592.                                         tdef->def.series.incr, tdef->def.series.end);
  593.              break;
  594.           }
  595.           case TIC_USER: {
  596.              register struct ticmark *t;
  597.              fprintf(fp, " (");
  598.              for (t = tdef->def.user; t != NULL; t=t->next) {
  599.                 if (t->label)
  600.                   fprintf(fp, "\"%s\" ", t->label);
  601.                 if (t->next)
  602.                   fprintf(fp, "%g, ", t->position);
  603.                 else
  604.                   fprintf(fp, "%g", t->position);
  605.              }
  606.              fprintf(fp, ")");
  607.              break;
  608.           } 
  609.        }
  610.        fprintf(fp, "\n");
  611.     } else {
  612.        fprintf(fp,"set no%ctics\n", axis);
  613.     }
  614. }
  615.  
  616. load_file(fp, name)
  617.     FILE *fp;
  618.     char *name;
  619. {
  620.     register int len;
  621.     extern char input_line[];
  622.  
  623.     int start, left;
  624.     int more;
  625.     int stop = FALSE;
  626.  
  627.     lf_push(fp);            /* save state for errors and recursion */
  628.  
  629.     if (fp == (FILE *)NULL) {
  630.        char errbuf[BUFSIZ];
  631.        (void) sprintf(errbuf, "Cannot open load file '%s'", name);
  632.        os_error(errbuf, c_token);
  633.     } else {
  634.        /* go into non-interactive mode during load */
  635.        /* will be undone below, or in load_file_error */
  636.        interactive = FALSE;
  637.        inline_num = 0;
  638.        infile_name = name;
  639.  
  640.        while (!stop) {        /* read all commands in file */
  641.           /* read one command */
  642.           left = MAX_LINE_LEN;
  643.           start = 0;
  644.           more = TRUE;
  645.  
  646.           while (more) {
  647.              if (fgets(&(input_line[start]), left, fp) == NULL) {
  648.                 stop = TRUE; /* EOF in file */
  649.                 input_line[start] = '\0';
  650.                 more = FALSE;    
  651.              } else {
  652.                 inline_num++;
  653.                 len = strlen(input_line) - 1;
  654.                 if (input_line[len] == '\n') { /* remove any newline */
  655.                     input_line[len] = '\0';
  656.                     /* Look, len was 1-1 = 0 before, take care here! */
  657.                     if (len > 0) --len;
  658.                 } else if (len+1 >= left)
  659.                   int_error("Input line too long",NO_CARET);
  660.                  
  661.                 if (input_line[len] == '\\') { /* line continuation */
  662.                     start = len;
  663.                     left  = MAX_LINE_LEN - start; /* left -=len;*/
  664.                 } else
  665.                   more = FALSE;
  666.              }
  667.           }
  668.  
  669.           if (strlen(input_line) > 0) {
  670.              screen_ok = FALSE;    /* make sure command line is
  671.                                echoed on error */
  672.              do_line();
  673.           }
  674.        }
  675.     }
  676.  
  677.     /* pop state */
  678.     (void) lf_pop();        /* also closes file fp */
  679. }
  680.  
  681. /* pop from load_file state stack */
  682. static BOOLEAN                /* FALSE if stack was empty */
  683. lf_pop()                    /* called by load_file and load_file_error */
  684. {
  685.     LFS *lf;
  686.  
  687.     if (lf_head == NULL)
  688.      return(FALSE);
  689.     else {
  690.        lf = lf_head;
  691.        if (lf->fp != (FILE *)NULL)
  692.         (void) fclose(lf->fp);
  693.        interactive = lf->interactive;
  694.        inline_num = lf->inline_num;
  695.        infile_name = lf->name;
  696.        lf_head = lf->prev;
  697.        free((char *)lf);
  698.        return(TRUE);
  699.     }
  700. }
  701.  
  702. /* push onto load_file state stack */
  703. /* essentially, we save information needed to undo the load_file changes */
  704. static void
  705. lf_push(fp)            /* called by load_file */
  706.     FILE *fp;
  707. {
  708.     LFS *lf;
  709.     
  710.     lf = (LFS *)alloc(sizeof(LFS), (char *)NULL);
  711.     if (lf == (LFS *)NULL) {
  712.        if (fp != (FILE *)NULL)
  713.         (void) fclose(fp);        /* it won't be otherwise */
  714.        int_error("not enough memory to load file", c_token);
  715.     }
  716.      
  717.     lf->fp = fp;            /* save this file pointer */
  718.     lf->name = infile_name;    /* save current name */
  719.     lf->interactive = interactive;    /* save current state */
  720.     lf->inline_num = inline_num; /* save current line number */
  721.     lf->prev = lf_head;        /* link to stack */
  722.     lf_head = lf;
  723. }
  724.  
  725. load_file_error()            /* called from main */
  726. {
  727.     /* clean up from error in load_file */
  728.     /* pop off everything on stack */
  729.     while(lf_pop())
  730.      ;
  731. }
  732.  
  733. /* find char c in string str; return p such that str[p]==c;
  734.  * if c not in str then p=strlen(str)
  735.  */
  736. int
  737. instring(str, c)
  738.     char *str;
  739.     char c;
  740. {
  741.     int pos = 0;
  742.  
  743.     while (str != NULL && *str != '\0' && c != *str) {
  744.        str++; 
  745.        pos++;
  746.     }
  747.     return (pos);
  748. }
  749.  
  750. show_functions()
  751. {
  752. register struct udft_entry *udf = first_udf;
  753.  
  754.     fprintf(stderr,"\n\tUser-Defined Functions:\n");
  755.  
  756.     while (udf) {
  757.         if (udf->definition)
  758.             fprintf(stderr,"\t%s\n",udf->definition);
  759.         else
  760.             fprintf(stderr,"\t%s is undefined\n",udf->udf_name);
  761.         udf = udf->next_udf;
  762.     }
  763. }
  764.  
  765.  
  766. show_at()
  767. {
  768.     (void) putc('\n',stderr);
  769.     disp_at(temp_at(),0);
  770. }
  771.  
  772.  
  773. disp_at(curr_at, level)
  774. struct at_type *curr_at;
  775. int level;
  776. {
  777. register int i, j;
  778. register union argument *arg;
  779.  
  780.     for (i = 0; i < curr_at->a_count; i++) {
  781.         (void) putc('\t',stderr);
  782.         for (j = 0; j < level; j++)
  783.             (void) putc(' ',stderr);    /* indent */
  784.  
  785.             /* print name of instruction */
  786.  
  787.         fputs(ft[(int)(curr_at->actions[i].index)].f_name,stderr);
  788.         arg = &(curr_at->actions[i].arg);
  789.  
  790.             /* now print optional argument */
  791.  
  792.         switch(curr_at->actions[i].index) {
  793.           case PUSH:    fprintf(stderr," %s\n", arg->udv_arg->udv_name);
  794.                     break;
  795.           case PUSHC:    (void) putc(' ',stderr);
  796.                     disp_value(stderr,&(arg->v_arg));
  797.                     (void) putc('\n',stderr);
  798.                     break;
  799.           case PUSHD1:    fprintf(stderr," %c dummy\n",
  800.                       arg->udf_arg->udf_name[0]);
  801.                     break;
  802.           case PUSHD2:    fprintf(stderr," %c dummy\n",
  803.                       arg->udf_arg->udf_name[1]);
  804.                     break;
  805.           case CALL:    fprintf(stderr," %s", arg->udf_arg->udf_name);
  806.                     if(level < 6) {
  807.                     if (arg->udf_arg->at) {
  808.                         (void) putc('\n',stderr);
  809.                         disp_at(arg->udf_arg->at,level+2); /* recurse! */
  810.                     } else
  811.                         fputs(" (undefined)\n",stderr);
  812.                     }
  813.                     break;
  814.           case CALL2:    fprintf(stderr," %s", arg->udf_arg->udf_name);
  815.                     if(level < 6) {
  816.                     if (arg->udf_arg->at) {
  817.                         (void) putc('\n',stderr);
  818.                         disp_at(arg->udf_arg->at,level+2); /* recurse! */
  819.                     } else
  820.                         fputs(" (undefined)\n",stderr);
  821.                     }
  822.                     break;
  823.           case JUMP:
  824.           case JUMPZ:
  825.           case JUMPNZ:
  826.           case JTERN:
  827.                     fprintf(stderr," +%d\n",arg->j_arg);
  828.                     break;
  829.           default:
  830.                     (void) putc('\n',stderr);
  831.         }
  832.     }
  833. }
  834.  
  835.  
  836. /* alloc:
  837.  * allocate memory 
  838.  * This is a protected version of malloc. It causes an int_error 
  839.  * if there is not enough memory, but first it tries FreeHelp() 
  840.  * to make some room, and tries again. If message is NULL, we 
  841.  * allow NULL return. Otherwise, we handle the error, using the
  842.  * message to create the int_error string. Note cp/sp_extend uses realloc,
  843.  * so it depends on this using malloc().
  844.  */
  845.  
  846. char *
  847. alloc(size, message)
  848.     unsigned int size;                /* # of bytes */
  849.     char *message;            /* description of what is being allocated */
  850. {
  851.     char *p;                /* the new allocation */
  852.     char errbuf[100];        /* error message string */
  853.  
  854.     p = malloc(size);
  855.     if (p == (char *)NULL) {
  856. #ifndef vms
  857.        FreeHelp();            /* out of memory, try to make some room */
  858. #endif
  859.        
  860.        p = malloc(size);        /* try again */
  861.        if (p == (char *)NULL) {
  862.           /* really out of memory */
  863.           if (message != NULL) {
  864.              (void) sprintf(errbuf, "out of memory for %s", message);
  865.              int_error(errbuf, NO_CARET);
  866.              /* NOTREACHED */
  867.           }
  868.           /* else we return NULL */
  869.        }
  870.     }
  871.  
  872.     return(p);
  873. }
  874.